VBA > Report > Draw American Flag

Code

Module

'*************** Code Start *****************************************************
' reference:
'  http://msaccessgurus.com/VBA/Code/AmericanFlag.htm
' module: mod_FlagAmerican_s4p
'-------------------------------------------------------------------------------
' Purpose  : Draw an American flag on an Access report, any size, any position.
' Author   : crystal (strive4peace)
' License  : below code
' Code List: www.msaccessgurus.com/code.htm
'-------------------------------------------------------------------------------
'           FlagAmerican
'-------------------------------------------------------------------------------

Public Sub FlagAmerican( _ 
    pReport As Report _ 
   ,ByVal pX As Single,ByVal pY As Single _ 
   ,ByVal pMaxWidth As Single _ 
   ,ByVal pMaxHeight As Single _ 
   ,Optional ByVal piColorSet As Integer = 0 _ 
   ) 
'200611 strive4peace, 200629
'called from code behind report on page to draw flag -- or send report object
'draw flag at pX, pY
'proportions for the American Flag are hard-coded based on the height
'measurements from:
'  https://www.ushistory.org/betsy/flagetiq3.html
'
'measurements in TWIPS
'uses font for stars: Wingdings 2

   Dim x2Flag As Single,y2Flag As Single _ 
   ,dXFlag As Single,dYFlag As Single _ 
   ,dXUnion As Single,dYUnion As Single _ 
   ,dYStripe As Single _ 
   ,dXStar As Single,dYStar As Single _ 
   ,HeightStar As Single,WidthStar As Single _ 
   ,sgFlagWidth2Height As Single _ 
   ,x1 As Single,y1 As Single _ 
   ,x2 As Single,y2 As Single _ 
   ,sgStarFontSize As Single _ 
   ,nBlue As Long _ 
   ,nRed As Long _ 
   ,nWhite As Long _ 
   ,nBlack As Long _ 
   ,i As Integer _ 
   ,j As Integer _ 
   ,iDrawWidth As Integer _ 
   ,sStar As String 
   
   If piColorSet <> 0 Then 
      'faded colors
      nBlue = 16772590  'RGB(238,237,255)
      nRed = 15127295  'RGB(255,210,230)
      nBlack = 14474460  'RGB(220,220,220)
   Else 
      'regular colors
      nBlue = 7223353  'RGB(57, 56, 110)
      nRed = 3218867  'RGB(179, 29, 49)
      nBlack = 0 
   End If 
   
   nWhite = 16777215  'RGB(255, 255, 255)
   
   'proportion for width:height
   sgFlagWidth2Height = 1.9 

   iDrawWidth = 2 
      
   'make sure proportions are right
   If pMaxHeight > pMaxWidth / sgFlagWidth2Height Then 
      dXFlag = pMaxWidth 
      dYFlag = pMaxWidth / sgFlagWidth2Height 
   Else 
      dXFlag = pMaxWidth * sgFlagWidth2Height 
      dYFlag = pMaxHeight 
   End If 
   
   'x2 and y2 for flag
   x2Flag = pX + dXFlag 
   y2Flag = pY + dYFlag 
   
      'size of union
   dXUnion = 0.76 * dYFlag 
   dYUnion = 7 / 13 * dYFlag 
   
   'height of stripe = 1/13 flag height
   dYStripe = dYFlag / 13 
   
   '--------------------- stripes
   x1 = pX + dXUnion 
   x2 = x2Flag 
   
   'draw red stripes, skip white stripes
   'stripes next to union
   For i = 1 To 7 Step 2 
      y1 = pY + (i - 1) * dYStripe 
      y2 = y1 + dYStripe 
      
      pReport.Line (x1,y1)-(x2,y2),nRed,BF 
   Next i 
   
   'stripes below union
   x1 = pX 
   For i = 9 To 13 Step 2 
      y1 = pY + (i - 1) * dYStripe 
      y2 = y1 + dYStripe 
      
      pReport.Line (x1,y1)-(x2,y2),nRed,BF 
   Next i 
   
   '--------------------- union
   
   'draw filled rectangle for union
   pReport.Line (pX,pY)-(pX + dXUnion,pY + dYUnion),nBlue,BF 
   
   '--------------------- stars
   'character to use for star
   sStar = Chr(234)  'font="Wingdings 2"
   
   dXStar = 0.063 * dYFlag 
   dYStar = 0.054 * dYFlag 
   sgStarFontSize = 0.0616 * dYFlag / 20 
   
   With pReport 
      .DrawWidth = iDrawWidth   'line width is 2 pixels
      .FontSize = sgStarFontSize  'iFontSize
      .FontName =  "Wingdings 2"
      .ForeColor = nWhite 
      
      WidthStar = .TextWidth(sStar) 
      HeightStar = .TextHeight(sStar) 
      
      y1 = pY + dYStar - HeightStar / 2 
	        
      For j = 1 To 5 
         x1 = pX + dXStar - WidthStar / 2 
         .CurrentY = y1      
		 
         For i = 1 To 6 
            .CurrentX = x1  
            .Print sStar 
            x1 = x1 + (2# * dXStar) 
         Next i 
         
         x1 = pX + (2 * dXStar) - WidthStar / 2 
         y1 = y1 + dYStar 
         .CurrentY = y1 		 
         
         If j <> 5 Then 
            For i = 1 To 5 
               .CurrentX = x1 
               .Print sStar 
               x1 = x1 + (2# * dXStar) 
            Next i 
         End If 
         
         y1 = y1 + dYStar 
         
      Next j 
      
   End With 
   
   'draw rectangle for flag
   pReport.Line (pX,pY)-(x2Flag,y2Flag),nBlack,B 
      
End Sub 

Goto Top  

Code behind reports

'-------------------------------------------------------------------------------
' Purpose  : draw a full page American flag
' Author   : crystal (strive4peace)
' License  : below code
' Code List: www.msaccessgurus.com/code.htm
'-------------------------------------------------------------------------------
'  NEEDS module:
'    mod_FlagAmerican_s4p
'-------------------------------------------------------------------------------

Private Sub Report_Page() 
'200612 strive4peace
'draw a full page American flag
   ' CALLS
   '  FlagAmerican
   
   Dim X As Single,Y As Single _ 
      ,dX As Single,dY As Single 
      
   With Me 
      .ScaleMode = 1  'twips
      X = .ScaleLeft 
      Y = .ScaleTop 
      dX = .ScaleWidth 
      dY = .ScaleHeight 
   End With 
   
   'draw a full page flag-- limited by proportional dimensions of flag
   Call FlagAmerican(Me,X,Y,dX,dY) 
   
End Sub 

'-------------------------------------------------------------------------------
' Purpose  : draw 4 flags diagonally down the page, faded color
' Author   : crystal (strive4peace)
' License  : below code
' Code List: www.msaccessgurus.com/code.htm
'-------------------------------------------------------------------------------
'  NEEDS module:
'    mod_FlagAmerican_s4p
'-------------------------------------------------------------------------------

Private Sub Report_Page() 
'200612 strive4peace
'draw 4 flags diagonally down the page, faded color
   ' CALLS
   '  FlagAmerican
   
   Dim X As Single,Y As Single _ 
      ,dX As Single,dY As Single _ 
      ,i As Integer 
      
   With Me 
      .ScaleMode = 1  'twips
      X = .ScaleLeft 
      Y = .ScaleTop 
      dX = .ScaleWidth / 4 
      dY = .ScaleHeight / 4 
   End With 
   
   For i = 1 To 4 
      'draw a quarter page flag-- limited by proportional dimensions of flag
      'color set <> 0 for faded colors
      Call FlagAmerican(Me,X,Y,dX,dY,1) 
      X = X + dX 
      Y = Y + dY 
   Next i 
   
End Sub 

'   You may freely use and share this code
'     provided this license notice and comment lines are not changed;
'     code may be modified provided you clearly note your changes.
'   You may not sell this code alone, or as part of a collection,
'     without my handwritten permission.
'   All ownership rights reserved. Use at your own risk.
'   ~ crystal (strive4peace)  www.msaccessgurus.com
'*************** Code End *******************************************************`

Keyword and comments in code were colored with Color Code add-in

Goto Top  

Goto Top  

Goto Top  

Goto Top